Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vbpong1a/ball2.cls

Visual Basic class definition | 1999-08-15 | 5.0 KB | 167 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Ball"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public x As Long, y As Long, xvel As Long, yvel As Long
Private surfBall As CDXVBSurface

Private Pixels(9) As PixelPoint

Public Sub Init(dd As CDXVBScreen, nx As Integer, ny As Integer, nxv, nyv, FN As String)
    Set surfBall = New CDXVBSurface
    surfBall.Create App.Path & "\" & FN, dd

    x = nx
    y = ny
    xvel = nxv
    yvel = nyv

    For i = 0 To UBound(Pixels)
        Pixels(i).bActive = False
        Pixels(i).decay = 30
    Next i
End Sub

Private Sub SpawnPixel()
    For i = 0 To UBound(Pixels)
        If Not Pixels(i).bActive Then
            Randomize

            Pixels(i).bActive = True
            Pixels(i).life = 255
            Pixels(i).t = Int(Rnd * 2)
            If xvel < 0 Then
                Pixels(i).x = x + 9 + Int(Rnd * 9)
            Else
                Pixels(i).x = x - Int(Rnd * 9)
            End If
            If yvel < 0 Then
                Pixels(i).y = y + 9 + Int(Rnd * 9)
            Else
                Pixels(i).y = y - Int(Rnd * 9)
            End If
            Pixels(i).decay = Int(Rnd * 20) + 20

            Exit For
        End If
    Next i
End Sub

Private Sub RenderPixels(surf As IDirectDrawSurface2, red As Boolean)
    Dim hDC As Long

    surf.GetDC hDC

    For i = 0 To UBound(Pixels)
        If Pixels(i).bActive Then
            If red Then
                If Pixels(i).t = 1 Then
                    SetPixel hDC, Pixels(i).x, Pixels(i).y, RGB(Pixels(i).life, 0, 0)
                    SetPixel hDC, Pixels(i).x - 1, Pixels(i).y, RGB(Pixels(i).life, 0, 0)
                    SetPixel hDC, Pixels(i).x, Pixels(i).y - 1, RGB(Pixels(i).life, 0, 0)
                    SetPixel hDC, Pixels(i).x + 1, Pixels(i).y, RGB(Pixels(i).life, 0, 0)
                    SetPixel hDC, Pixels(i).x, Pixels(i).y + 1, RGB(Pixels(i).life, 0, 0)
                Else
                    SetPixel hDC, Pixels(i).x, Pixels(i).y, RGB(Pixels(i).life, 0, 0)
                End If
            Else
                If Pixels(i).t = 1 Then
                    SetPixel hDC, Pixels(i).x, Pixels(i).y, RGB(0, Pixels(i).life, 0)
                    SetPixel hDC, Pixels(i).x - 1, Pixels(i).y, RGB(0, Pixels(i).life, 0)
                    SetPixel hDC, Pixels(i).x, Pixels(i).y - 1, RGB(0, Pixels(i).life, 0)
                    SetPixel hDC, Pixels(i).x + 1, Pixels(i).y, RGB(0, Pixels(i).life, 0)
                    SetPixel hDC, Pixels(i).x, Pixels(i).y + 1, RGB(0, Pixels(i).life, 0)
                Else
                    SetPixel hDC, Pixels(i).x, Pixels(i).y, RGB(0, Pixels(i).life, 0)
                End If
            End If

            Pixels(i).life = Pixels(i).life - Pixels(i).decay
            If Pixels(i).life <= 0 Then Pixels(i).bActive = False
        End If
    Next i

    surf.ReleaseDC hDC
End Sub

Public Sub Move(p1 As Player, p2 As Player, b1 As Ball, itype As Integer)
    Dim p1r As RECT, p2r As RECT, ballr1 As RECT, ballr2 As RECT, dr As RECT
    With p1r
        .Top = p1.y
        .Left = p1.x
        .Bottom = p1.y + 40
        .Right = p1.x + 10
    End With
    With p2r
        .Top = p2.y
        .Left = p2.x
        .Bottom = p2.y + 40
        .Right = p2.x + 10
    End With
    With ballr1
        .Top = y
        .Left = x
        .Bottom = y + 9
        .Right = x + 9
    End With
    With ballr2
        .Top = b1.y
        .Left = b1.x
        .Bottom = b1.y + 9
        .Right = b1.x + 9
    End With

    x = x + xvel
    y = y + yvel

    If x < 0 Then
        x = 0
        xvel = -xvel
        BlockCode.RestoreRedBlock
        DSoundCode.PlayBounce1
    End If
    If x > 631 Then
        x = 631
        xvel = -xvel
        BlockCode.RestoreGreenBlock
        DSoundCode.PlayBounce1
    End If
    If y < 10 Then y = 10: yvel = -yvel: DSoundCode.PlayBounce1
    If y > 371 Then y = 371: yvel = -yvel: DSoundCode.PlayBounce1

    ' Bat collision detection
    If IntersectRect(dr, p1r, ballr1) Then
        x = p1.x + 10
        xvel = -xvel
        yvel = (dr.Top - x) / 64
        DSoundCode.PlayBounce1
    End If
    If IntersectRect(dr, p2r, ballr1) Then
        x = p2.x - 9
        xvel = -xvel
        yvel = (dr.Top - x) / 64
        DSoundCode.PlayBounce1
    End If
    If IntersectRect(dr, ballr1, ballr2) Then
        xvel = -xvel
        x = x + xvel
        b1.xvel = -b1.xvel
        b1.x = b1.x + b1.xvel
    End If
End Sub

Public Sub Draw(back As IDirectDrawSurface2, red As Boolean)
    surfBall.Blit x, y, back
    SpawnPixel
    RenderPixels back, red
End Sub